home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / DEBUG / BPTRAP10 / BPTRAP.PAS next >
Encoding:
Pascal/Delphi Source File  |  1996-02-29  |  3.8 KB  |  139 lines
  1. UNIT BPTrap;
  2.  
  3. { Trap runtime errors, Version 1.0
  4.   Copyright (C) 1991-1996 by Frank Heckenbach, heckenb@mi.uni-erlangen.de
  5.  
  6.   This program is free software; you can redistribute it and/or modify
  7.   it under the terms of the GNU General Public License as published by
  8.   the Free Software Foundation, version 1, for NON-COMMERCIAL use.
  9.  
  10.   This program is distributed in the hope that it will be useful,
  11.   but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13.   GNU General Public License for more details.
  14.  
  15.   You should have received a copy of the GNU General Public License
  16.   along with this program; if not, write to the Free Software
  17.   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. }
  18.  
  19. {$IFNDEF VER70}
  20. This unit was tested only with Borland Pascal 7.0. You can use it with other
  21. versions by commenting these two lines, but at your own risk!
  22. {$ENDIF}
  23.  
  24. INTERFACE
  25.  
  26. FUNCTION  Trap:Boolean; FAR;
  27. {* Returns False on installation.
  28.  * After trapping a runtime error it jumps back to where the function was
  29.    called returning True.
  30.  * The procedure that calls Trap must NOT return as long as Trap is installed
  31.    (so it is safest to call Trap from the main program, if possible)!
  32.  * You must call this function AFTER installing all other Exitprocs (if any).
  33.  * In Real mode: You must NOT call it from an overlayed unit.
  34.  * In Protected mode and Windoze: You must call it from a code segment with
  35.    the following attributes: FIXED PRELOAD PERMANENT. (I am not sure if this
  36.    is really necessary...).}
  37.  
  38. FUNCTION UnTrap:Boolean;
  39. {Returns True iff Trap could be uninstalled.}
  40.  
  41. IMPLEMENTATION
  42.  
  43. TYPE ptrrec=RECORD ofs,sgm:Word END;
  44.  
  45. CONST
  46.   addrsave:Pointer=NIL;
  47.   codesave:Word=0;
  48.  
  49. VAR
  50.   exitsave,trapaddr:Pointer;
  51.   trapsp,trapbp:Word;
  52.  
  53. {$S-}
  54. PROCEDURE Trapexit; FAR;
  55. BEGIN
  56.   IF Erroraddr<>NIL
  57.     THEN {Trapping runtime error}
  58.       BEGIN
  59.         {Install Trapexit again (in case another runtime error occurs later)!}
  60.         Exitproc:=@Trapexit;
  61.  
  62.         {Keep error address and exit code and reset these variables}
  63.         addrsave:=Erroraddr;
  64.         codesave:=Exitcode;
  65.         Erroraddr:=NIL;
  66.         Exitcode:=0;
  67.  
  68.         {If you want, you can do something here to indicate the user that an
  69.          error occurred. You could e.g. pop up a message telling the user to
  70.          quit the program asap and report the error to the programmer.}
  71.  
  72.         ASM
  73.           {Load the saved SP and BP registers}
  74.           MOV  SP,trapsp
  75.           MOV  BP,trapbp
  76.  
  77.           {Continue at saved address returning True}
  78.           MOV  AL,1
  79.           JMP  [trapaddr]
  80.         END
  81.       END
  82.  
  83.     ELSE {Programm finished without an error}
  84.       BEGIN
  85.         {Continue with other exit procs}
  86.         Exitproc:=exitsave;
  87.  
  88.         {Restore error address and exit code of the last trapped error, if any}
  89.         IF addrsave<>NIL THEN
  90.           BEGIN
  91.             Erroraddr:=addrsave;
  92.             Exitcode:=codesave
  93.           END
  94.       END
  95. END;
  96.  
  97. FUNCTION Trap:Boolean; ASSEMBLER;
  98. ASM
  99.    {Install Trapexit as an Exitproc}
  100.    MOV  AX,OFFSET Trapexit
  101.    MOV  DX,SEG Trapexit
  102.    CMP  Exitproc.ptrrec.ofs,AX
  103.    JNE  @1
  104.    CMP  Exitproc.ptrrec.sgm,DX
  105.    JE   @2
  106. @1:XCHG Exitproc.ptrrec.ofs,AX
  107.    XCHG Exitproc.ptrrec.sgm,DX
  108.    MOV  exitsave.ptrrec.ofs,AX
  109.    MOV  exitsave.ptrrec.sgm,DX
  110.  
  111.    {Save SP and BP registers and the return address}
  112. @2:MOV  trapbp,BP
  113.    MOV  SI,SP
  114.    {$IFDEF WINDOWS}
  115.    ADD  SI,4
  116.    ADD  trapbp,6
  117.    {$ENDIF}
  118.    LES  DI,SS:[SI]
  119.    MOV  trapaddr.ptrrec.ofs,DI
  120.    MOV  trapaddr.ptrrec.sgm,ES
  121.    ADD  SI,4
  122.    MOV  trapsp,SI
  123.  
  124.    {Return False}
  125.    XOR  AX,AX
  126. END;
  127.  
  128. FUNCTION UnTrap:Boolean;
  129. BEGIN
  130.   IF Exitproc=@Trapexit
  131.     THEN
  132.       BEGIN
  133.         Exitproc:=exitsave;
  134.         UnTrap:=True
  135.       END
  136.     ELSE UnTrap:=False
  137. END;
  138. END.
  139.